home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH9 / SRC / ROTORDER.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-11-16  |  10.2 KB  |  344 lines
  1. VERSION 4.00
  2. Begin VB.Form RotateForm 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Order of Rotation"
  6.    ClientHeight    =   5670
  7.    ClientLeft      =   825
  8.    ClientTop       =   915
  9.    ClientWidth     =   8190
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   1
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   6360
  21.    KeyPreview      =   -1  'True
  22.    Left            =   765
  23.    LinkTopic       =   "Form1"
  24.    ScaleHeight     =   5670
  25.    ScaleWidth      =   8190
  26.    Top             =   285
  27.    Width           =   8310
  28.    Begin VB.PictureBox Proj 
  29.       AutoRedraw      =   -1  'True
  30.       Height          =   2655
  31.       Index           =   0
  32.       Left            =   0
  33.       ScaleHeight     =   -5
  34.       ScaleLeft       =   -2
  35.       ScaleMode       =   0  'User
  36.       ScaleTop        =   2
  37.       ScaleWidth      =   5
  38.       TabIndex        =   5
  39.       Top             =   3000
  40.       Width           =   2655
  41.    End
  42.    Begin VB.PictureBox Proj 
  43.       AutoRedraw      =   -1  'True
  44.       Height          =   2655
  45.       Index           =   1
  46.       Left            =   2760
  47.       ScaleHeight     =   -5
  48.       ScaleLeft       =   -2
  49.       ScaleMode       =   0  'User
  50.       ScaleTop        =   2
  51.       ScaleWidth      =   5
  52.       TabIndex        =   4
  53.       Top             =   3000
  54.       Width           =   2655
  55.    End
  56.    Begin VB.PictureBox Proj 
  57.       AutoRedraw      =   -1  'True
  58.       Height          =   2655
  59.       Index           =   2
  60.       Left            =   5520
  61.       ScaleHeight     =   -5
  62.       ScaleLeft       =   -2
  63.       ScaleMode       =   0  'User
  64.       ScaleTop        =   2
  65.       ScaleWidth      =   5
  66.       TabIndex        =   3
  67.       Top             =   3000
  68.       Width           =   2655
  69.    End
  70.    Begin VB.PictureBox Pict 
  71.       AutoRedraw      =   -1  'True
  72.       Height          =   2655
  73.       Index           =   2
  74.       Left            =   5520
  75.       ScaleHeight     =   -5
  76.       ScaleLeft       =   -2
  77.       ScaleMode       =   0  'User
  78.       ScaleTop        =   2
  79.       ScaleWidth      =   5
  80.       TabIndex        =   2
  81.       Top             =   240
  82.       Width           =   2655
  83.    End
  84.    Begin VB.PictureBox Pict 
  85.       AutoRedraw      =   -1  'True
  86.       Height          =   2655
  87.       Index           =   1
  88.       Left            =   2760
  89.       ScaleHeight     =   -5
  90.       ScaleLeft       =   -2
  91.       ScaleMode       =   0  'User
  92.       ScaleTop        =   2
  93.       ScaleWidth      =   5
  94.       TabIndex        =   1
  95.       Top             =   240
  96.       Width           =   2655
  97.    End
  98.    Begin VB.PictureBox Pict 
  99.       AutoRedraw      =   -1  'True
  100.       Height          =   2655
  101.       Index           =   0
  102.       Left            =   0
  103.       ScaleHeight     =   -5
  104.       ScaleLeft       =   -2
  105.       ScaleMode       =   0  'User
  106.       ScaleTop        =   2
  107.       ScaleWidth      =   5
  108.       TabIndex        =   0
  109.       Top             =   240
  110.       Width           =   2655
  111.    End
  112.    Begin VB.Label Label1 
  113.       Alignment       =   2  'Center
  114.       Caption         =   "Directly around a line"
  115.       Height          =   255
  116.       Index           =   2
  117.       Left            =   5520
  118.       TabIndex        =   8
  119.       Top             =   0
  120.       Width           =   2655
  121.    End
  122.    Begin VB.Label Label1 
  123.       Alignment       =   2  'Center
  124.       Caption         =   "Into X-Z plane first"
  125.       Height          =   255
  126.       Index           =   1
  127.       Left            =   2760
  128.       TabIndex        =   7
  129.       Top             =   0
  130.       Width           =   2655
  131.    End
  132.    Begin VB.Label Label1 
  133.       Alignment       =   2  'Center
  134.       Caption         =   "Into Y-Z plane first"
  135.       Height          =   255
  136.       Index           =   0
  137.       Left            =   0
  138.       TabIndex        =   6
  139.       Top             =   0
  140.       Width           =   2655
  141.    End
  142.    Begin VB.Menu mnuFile 
  143.       Caption         =   "&File"
  144.       Begin VB.Menu mnuFileExit 
  145.          Caption         =   "E&xit"
  146.       End
  147.    End
  148. Attribute VB_Name = "RotateForm"
  149. Attribute VB_Creatable = False
  150. Attribute VB_Exposed = False
  151. Option Explicit
  152. ' Point being rotated into the Z axis.
  153. Const Px = 2
  154. Const Py = 2
  155. Const Pz = 1
  156. ' Line for direct rotation.
  157. Const Vx = 1
  158. Const Vy = 1
  159. Const Vz = 2
  160. ' Location of viewing eye.
  161. Dim EyeR As Single
  162. Dim EyeTheta As Single
  163. Dim EyePhi As Single
  164. ' Location of focus point.
  165. Const FocusX = 0#
  166. Const FocusY = 0#
  167. Const FocusZ = 0#
  168. Dim Projector(1 To 4, 1 To 4) As Single
  169. ' Matrices used for the reflection.
  170. Dim M1(1 To 4, 1 To 4) As Single
  171. Dim M2(1 To 4, 1 To 4) As Single
  172. Dim M3(1 To 4, 1 To 4) As Single
  173. Dim M4(1 To 4, 1 To 4) As Single
  174. Dim M5(1 To 4, 1 To 4) As Single
  175. Dim Identity(1 To 4, 1 To 4) As Single
  176. Sub CreateMatrices()
  177. Dim sin1 As Single
  178. Dim cos1 As Single
  179. Dim sin2 As Single
  180. Dim cos2 As Single
  181. Dim d1 As Single
  182. Dim d2 As Single
  183.     m3Identity Identity
  184.     ' *************
  185.     ' * Y-Z first *
  186.     ' *************
  187.     d1 = Sqr(Px * Px + Pz * Pz)
  188.     sin1 = -Px / d1
  189.     cos1 = Pz / d1
  190.     d2 = Sqr(Px * Px + Py * Py + Pz * Pz)
  191.     sin2 = Py / d2
  192.     cos2 = d1 / d2
  193.     m3Identity M1       ' Around Y into Y-Z plane.
  194.     M1(1, 1) = cos1
  195.     M1(1, 3) = -sin1
  196.     M1(3, 1) = sin1
  197.     M1(3, 3) = cos1
  198.     m3Identity M2       ' Around X into Z axis.
  199.     M2(2, 2) = cos2
  200.     M2(2, 3) = sin2
  201.     M2(3, 2) = -sin2
  202.     M2(3, 3) = cos2
  203.         
  204.     ' *************
  205.     ' * X-Z first *
  206.     ' *************
  207.     d1 = Sqr(Py * Py + Pz * Pz)
  208.     sin1 = Py / d1
  209.     cos1 = Pz / d1
  210.     d2 = Sqr(Px * Px + Py * Py + Pz * Pz)
  211.     sin2 = -Px / d2
  212.     cos2 = d1 / d2
  213.     m3Identity M3       ' Around X into X-Z plane.
  214.     M3(2, 2) = cos1
  215.     M3(2, 3) = sin1
  216.     M3(3, 2) = -sin1
  217.     M3(3, 3) = cos1
  218.     m3Identity M4       ' Around Y into Z axis.
  219.     M4(1, 1) = cos2
  220.     M4(1, 3) = -sin2
  221.     M4(3, 1) = sin2
  222.     M4(3, 3) = cos2
  223.     ' ***************
  224.     ' * Around line *
  225.     ' ***************
  226.     m3LineRotate M5, 0, 0, 0, Vx, Vy, Vz, PI
  227. End Sub
  228. ' ***********************************************
  229. ' Let the user change the location of the eye.
  230. ' ***********************************************
  231. Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
  232. Const Dtheta = PI / 20
  233.     Select Case KeyCode
  234.         Case vbKeyLeft
  235.             EyeTheta = EyeTheta - Dtheta
  236.             
  237.         Case vbKeyRight
  238.             EyeTheta = EyeTheta + Dtheta
  239.         
  240.         Case vbKeyUp
  241.             EyePhi = EyePhi - Dtheta
  242.         
  243.         Case vbKeyDown
  244.             EyePhi = EyePhi + Dtheta
  245.         
  246.         Case Else
  247.             Exit Sub
  248.     End Select
  249.     ' Redraw the pictures.
  250.     DrawTheData
  251. End Sub
  252. Private Sub Form_Load()
  253.     ' Initialize the eye position.
  254.     EyeR = 3
  255.     EyeTheta = PI * 0.4
  256.     EyePhi = PI * 0.1
  257.     ' Create the rotation matrices.
  258.     CreateMatrices
  259.     ' Create, project, and draw the data.
  260.     DrawTheData
  261. End Sub
  262. ' ***********************************************
  263. ' Draw all the pictures.
  264. ' ***********************************************
  265. Sub DrawTheData()
  266. Dim i As Integer
  267.     ' Compute the projection matrix.
  268.     m3PProject Projector, m3Parallel, EyeR, EyePhi, EyeTheta, FocusX, FocusY, FocusZ, 0, 1, 0
  269.     ' ***********************
  270.     ' * Around Y axis first *
  271.     ' ***********************
  272.     CreateData
  273.     TransformAllData Projector
  274.     DrawSomeData Pict(0), 1, 3, vbRed, True
  275.     DrawSomeData Pict(0), 5, NumSegments, ForeColor, False
  276.     TransformData M1, 5, NumSegments
  277.     SetPoints 5, NumSegments
  278.     TransformData Projector, 5, NumSegments
  279.     DrawSomeData Pict(0), 5, NumSegments, ForeColor, False
  280.     TransformData M2, 5, NumSegments
  281.     SetPoints 5, NumSegments
  282.     TransformData Projector, 5, NumSegments
  283.     DrawSomeData Pict(0), 5, NumSegments, ForeColor, False
  284.     TransformAllData Identity
  285.     DrawSomeData Proj(0), 1, 3, vbRed, True
  286.     DrawSomeData Proj(0), 5, NumSegments, ForeColor, False
  287.     ' ***********************
  288.     ' * Around X axis first *
  289.     ' ***********************
  290.     CreateData
  291.     TransformAllData Projector
  292.     DrawSomeData Pict(1), 1, 3, vbRed, True
  293.     DrawSomeData Pict(1), 5, NumSegments, ForeColor, False
  294.         
  295.     TransformData M3, 5, NumSegments
  296.     SetPoints 5, NumSegments
  297.     TransformData Projector, 5, NumSegments
  298.     DrawSomeData Pict(1), 5, NumSegments, ForeColor, False
  299.     TransformData M4, 5, NumSegments
  300.     SetPoints 5, NumSegments
  301.     TransformData Projector, 5, NumSegments
  302.     DrawSomeData Pict(1), 5, NumSegments, ForeColor, False
  303.     TransformAllData Identity
  304.     DrawSomeData Proj(1), 1, 3, vbRed, True
  305.     DrawSomeData Proj(1), 5, NumSegments, ForeColor, False
  306.     ' ***************
  307.     ' * Around line *
  308.     ' ***************
  309.     CreateData
  310.     TransformAllData Projector
  311.     DrawSomeData Pict(2), 1, 3, vbRed, True
  312.     DrawSomeData Pict(2), 4, 4, vbBlue, False
  313.     DrawSomeData Pict(2), 5, NumSegments, ForeColor, False
  314.         
  315.     TransformData M5, 5, NumSegments
  316.     SetPoints 5, NumSegments
  317.     TransformData Projector, 5, NumSegments
  318.     DrawSomeData Pict(2), 5, NumSegments, ForeColor, False
  319.     TransformAllData Identity
  320.     DrawSomeData Proj(2), 1, 3, vbRed, True
  321.     DrawSomeData Proj(2), 5, NumSegments, ForeColor, False
  322.     For i = 0 To 2
  323.         Pict(i).Refresh
  324.         Proj(i).Refresh
  325.     Next i
  326. End Sub
  327. Sub CreateData()
  328.     ' Start with no data.
  329.     NumSegments = 0
  330.     ' Create the axes.
  331.     MakeSegment 0, 0, 0, 5, 0, 0    ' X axis.
  332.     MakeSegment 0, 0, 0, 0, 5, 0    ' Y axis.
  333.     MakeSegment 0, 0, 0, 0, 0, 5    ' Z axis.
  334.     ' Create the line.
  335.     MakeSegment -2 * Vx, -2 * Vy, -2 * Vz, 2 * Vx, 2 * Vy, 2 * Vz
  336.     ' Create the object to reflect.
  337.     MakeSegment Px, Py, Pz, Px, Py - 1, Pz - 1
  338.     MakeSegment Px, Py - 1, Pz - 1, Px, Py - 1, Pz + 1
  339.     MakeSegment Px, Py - 1, Pz + 1, Px, Py, Pz
  340. End Sub
  341. Private Sub mnuFileExit_Click()
  342.     Unload Me
  343. End Sub
  344.